home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / vidbasic.zip / DEMO.BAS next >
BASIC Source File  |  1990-11-29  |  15KB  |  535 lines
  1. DEFINT A-Z
  2. '===========================================================================
  3. 'Demo of all the video routines.
  4. 'Updated 11/26/90
  5. '===========================================================================
  6. REM $INCLUDE: 'VIDEO.BI'
  7.  
  8. 'Main routines
  9.  
  10. DECLARE SUB NormalWindow (ULR%, ULC%, LRR%, LRC%, ATTR%, BORDER%, LABEL$)
  11. DECLARE SUB ExplodingWindow (ULR%, ULC%, LRR%, LRC%, ATTR%, BORDER%, LABEL$)
  12. DECLARE SUB DropWindow (ULR%, ULC%, LRR%, LRC%, ATTR%, BORDER%, LABEL$)
  13. DECLARE SUB ExplodingDrop (ULR%, ULC%, LRR%, LRC%, ATTR%, BORDER%, LABEL$)
  14.  
  15. 'Help routines
  16.  ' This makes text move up and down
  17. DECLARE SUB FunScroll (ULR%, ULC%, LRR%, LRC%, ATTR%)
  18.  ' Scrolls text down three rows
  19. DECLARE SUB DownRow (ULR%, ULC%, LRR%, LRC%, ATTR%)
  20.  ' Clears the display from the outside in.
  21. DECLARE SUB ClearCircle ()
  22.  ' Allow for a time delay so can see the action.  This is a suboptimal routine
  23.  ' a better version is descibed in the Delayer header
  24. DECLARE SUB Delayer (Factor!)
  25.  
  26. 'Selects the Border% Elements based on Choice of Border%
  27. 'Listed by Border% Number
  28.     'Double Line Border%                           'Border% 1
  29.     'Single Line Border%                           'Border% 2
  30.     'Double Horizontal Single Vertical Border%     'Border% 3
  31.     'Double Vertical Single Horizontal Border%     'Border% 4
  32.     'Hash Border% (the default for case else)      'Border% 5
  33.  
  34. DIM Scrn%(2000) 'Display storage area
  35.  
  36. 'These are the Border% elements
  37. DIM SHARED Factor!
  38.  
  39. '------------------- Regular Window Module -------------------------------
  40. CLS
  41. 'turn cursor off, the same as LOCATE ,,0
  42. CALL CURSET(0)
  43.  
  44. 'if have EGA/VGA MONO use HERC type attributes
  45. CALL EGAMONO(1)
  46.  
  47.     ULC = 1: LRC = 80
  48.     ULR = 1: LRR = 25:
  49.     BORDER% = 1
  50.     LABEL$ = "Normal Box"
  51.    
  52. SELECT CASE VIDEOSTAT     'test for display that can show color well
  53.     CASE -3, -2, 0, 3, 4, 10
  54.         Attrib1 = &H7   'Select white on black
  55.                      'for Herc, COMPAQ, AT&T, EGA/VGA mono display
  56.         ATTR% = &H70    'Background color = 7: Foreground color = 0
  57.     CASE ELSE
  58.         Attrib1 = &H17  'select White on blue for other displays
  59.         ATTR% = &H30    'Background color = 3: Foreground color = 0
  60. END SELECT
  61.  
  62.     
  63.     CALL NormalWindow(ULR%, ULC%, LRR%, LRC%, ATTR%, BORDER%, LABEL$)
  64.     ' Save screen 1
  65.     CALL SAVESCRN(VARSEG(Scrn%(0)), VARPTR(Scrn%(0)))
  66.  
  67. DO
  68.     
  69.     CALL RESTSCRN(VARSEG(Scrn%(0)), VARPTR(Scrn%(0)))
  70.     CALL Delayer(.18)
  71.  
  72.     IF LEN(INKEY$) THEN EXIT DO    'faster than testing if INKEY$ = ""
  73.     
  74.     ULC = 9: LRC = 70
  75.     ULR = 3: LRR = 17:
  76.     BORDER% = 4 OR 256
  77.     LABEL$ = "Drop Box"
  78.     ATTR% = &H17    'Back = 1: Fore = 7
  79.     CALL DropWindow(ULR%, ULC%, LRR%, LRC%, ATTR%, BORDER%, LABEL$)
  80.     Text$ = "Moving Text"
  81.     CALL QPRINT(ULR% + 1, ULC% + 25, Text$, &H1E)
  82.     CALL Delayer(.18)
  83.     
  84.     IF LEN(INKEY$) THEN EXIT DO
  85.     
  86.     ULC = 12: LRC = 67
  87.     ULR = 10: LRR = 21:
  88.     LABEL$ = "Exploding Drop Box"
  89.     BORDER% = 2 OR 256
  90.     ATTR% = &H47   'Back = 4: Fore = 7
  91.     CALL ExplodingDrop(ULR%, ULC%, LRR%, LRC%, ATTR%, BORDER%, LABEL$)
  92.     
  93.     CALL DownRow(4, 10, 8, 68, &H1E)
  94.     
  95.     IF LEN(INKEY$) THEN EXIT DO
  96.     
  97.     BORDER% = 2 OR 256 'add shadow to border type 2 with OR 256
  98.     ULC = 30: LRC = 54
  99.     ULR = 16: LRR = 23:
  100.     LABEL$ = "Another Drop Box"
  101.     ATTR% = &H2F     'Back = 2: Fore = 15
  102.                   'don't use black foreground w/ green background
  103.                   'if will have an EGA mono display because it
  104.                   'wont show up
  105.     CALL DropWindow(ULR%, ULC%, LRR%, LRC%, ATTR%, BORDER%, LABEL$)
  106.     
  107.     Text$ = "(c) S J Kelly 1990"  'faster if assign text to variable
  108.     CALL QPRINT(ULR% + 1, ULC% + 3, Text$, &H2F)
  109.     CALL FunScroll(ULR% + 1, ULC% + 1, LRR% - 1, LRC% - 1, &H2F)
  110.     
  111.     IF LEN(INKEY$) THEN EXIT DO
  112.     
  113.     BORDER% = 3 OR 256
  114.     ULC = 63: LRC = 77
  115.     ULR = 2: LRR = 11:
  116.     LABEL$ = "Tiny"
  117.     ATTR% = &H5E      'Back = 5: Fore = 14
  118.     CALL DropWindow(ULR%, ULC%, LRR%, LRC%, ATTR%, BORDER%, LABEL$)
  119.     Text$ = "Bounce text"
  120.     CALL QPRINT(ULR% + 1, ULC% + 2, Text$, ATTR%)
  121.     
  122.     CALL Delayer(.18)
  123.     
  124.     CALL FunScroll(ULR% + 1, ULC% + 2, LRR% - 1, LRC% - 1, ATTR%)
  125.     CALL FunScroll(ULR% + 1, ULC% + 2, LRR% - 1, LRC% - 1, ATTR%)
  126.     
  127.     CALL Delayer(.13)
  128.     
  129.     ULC = 2: LRC = 25
  130.     ULR = 18: LRR = 24:
  131.     LABEL$ = "Lower Box"
  132.     BORDER% = 2
  133.     ATTR% = &H70     'Back = 7: Fore = 0
  134.     CALL ExplodingWindow(ULR%, ULC%, LRR%, LRC%, ATTR%, BORDER%, LABEL$)
  135.     CALL Delayer(.4)
  136.  
  137.     IF LEN(INKEY$) THEN EXIT DO
  138.  
  139. LOOP
  140. CALL SAVESCRN(VARSEG(Scrn%(0)), VARPTR(Scrn%(0)))
  141.  
  142. 'Clears the display when complete
  143. CALL ClearCircle
  144.  
  145. 'shows that the text was not affected
  146. ULR = 1: ULC = 1: LRR = 25: LRC = 80
  147.  
  148. FOR X% = 0 TO 120 STEP 5
  149.     CALL CLEARAREA(ULR, ULC, LRR, LRC, X%)
  150.     CALL Delayer(.25)
  151.     CALL RESTSCRN(VARSEG(Scrn%(0)), VARPTR(Scrn%(0)))
  152.     CALL Delayer(.15)
  153. NEXT X%
  154.  
  155. CALL Delayer(.1)
  156.  
  157. IF (Attrib1 = &H17) THEN    ' if have a display that can show color well
  158.     'show how one set of colors can be changed at a time
  159.     CALL RECOLOR(&H70, &H17)
  160.     CALL Delayer(.15)
  161.     CALL RECOLOR(&H5E, &H17)
  162.     CALL Delayer(.15)
  163.     CALL RECOLOR(&H2F, &H17)
  164.     CALL Delayer(.15)
  165.     CALL RECOLOR(&H47, &H17)
  166.     CALL Delayer(.15)
  167.     CALL RECOLOR(&H1E, &H17)
  168.     CALL Delayer(.15)
  169.     CALL RECOLOR(&H7, &H20)
  170.     CALL Delayer(.15)
  171.     CALL RECOLOR(&H30, &H40)
  172. END IF
  173.  
  174. CALL Delayer(2)
  175. CALL EGAMONO(0)    'turn of EGA mono pallette, use default
  176.  
  177. CALL FADE          'fade out display
  178.  
  179.  
  180.  
  181. CALL SETQP(10, 10, Attrib1) 'set up information for QPRINTL
  182.  
  183. Text$ = "Status information concerning your video adapter."
  184. CALL QPRT(10, 10, Text$)   'note that no attribute has to be selected
  185.  
  186. IF DUALDISPLAY% THEN
  187.     Text$ = "You have a DUAL DISPLAY, so I will select the other."
  188.     CALL QPRT(11, 10, Text$)
  189.         
  190.         IF INCOLOR THEN
  191.             CALL SWAPMONO       'sets any herc to half mode if have 2 displays
  192.             CALL QPRINTL("A mono display.")
  193.             CALL Delayer(.45)
  194.             CALL SWAPCOLOR
  195.         ELSE
  196.             CALL SWAPCOLOR
  197.             CALL QPRINTL("A color display.")
  198.             CALL Delayer(.45)
  199.             CALL SWAPMONO       'sets any herc to half mode if have 2 displays
  200.         END IF
  201.             
  202.         SCREEN 0: WIDTH 80, 25
  203.         LOCATE 1, 1
  204.  
  205. ELSE
  206.     Text$ = "You only have one display type active: "
  207.     CALL QPRT(12, 10, Text$)
  208.     IF FINDCOLOR% THEN
  209.         CALL QPRINTL("A color display.")
  210.     ELSE
  211.         CALL QPRINTL("A mono display.")
  212.     END IF
  213. END IF
  214.  
  215. LOCATE 13, 10
  216. PRINT "Active Display:  ";
  217.     SELECT CASE VIDEOSTAT%
  218.         CASE 13
  219.             PRINT "VGA with color";
  220.         CASE 11
  221.             PRINT "MCGA with color";
  222.         CASE 10
  223.             PRINT "EGA, VGA or MCGA monochrome";
  224.         CASE 9
  225.             PRINT "EGA with color ECD";
  226.         CASE 8
  227.             PRINT "64KB EGA with color ECD";
  228.         CASE 4
  229.             PRINT "AT&T single color CGA";
  230.         CASE 3
  231.             PRINT "Hercules, with graphics enabled ";
  232.         CASE 2
  233.             PRINT "CGA";
  234.         CASE 0
  235.             PRINT "normal mono";
  236.         CASE -2
  237.             PRINT "COMPAQ single color CGA";
  238.         CASE -3
  239.             PRINT "Hercules, (but MSHERC.COM is not installed)";
  240.         CASE -8
  241.             PRINT "64KB EGA with CGA";
  242.         CASE -9
  243.             PRINT "EGA with CGA";
  244.         CASE -11
  245.             PRINT "MCGA with ECD";
  246.         CASE ELSE
  247.             PRINT "error";
  248.     END SELECT
  249.     PRINT " display."
  250.     PRINT
  251.  
  252. CALL VIDINFO(Mode%, ROW%, COLUMN%, CURPAGE%, PAGESIZE%)
  253. LOCATE , 10
  254. PRINT "Current Bios Mode: "; Mode%
  255. LOCATE , 10
  256. PRINT "Current Length of display:"; ROW; "lines."
  257. LOCATE , 10
  258. PRINT "Current Width of display:"; COLUMN%; "columns."
  259. LOCATE , 10
  260. PRINT "The current active Page:"; CURPAGE%
  261. LOCATE , 10
  262. PRINT "The current Pagesize: ";
  263. PRINT USING "#####,"; PAGESIZE%; : PRINT " bytes."
  264.  
  265. Text$ = "The End!!"    'faster if assign text to variable
  266. CALL VPRINT(1, 1, Text$, &H47)  'shows vertical printing
  267.  
  268. Text$ = "Copyright Copr. 1990, Sidney J. Kelly, All Rights Reserved"
  269. CALL QPRINT(2, 5, Text$, &H47)
  270.  
  271. END
  272.  
  273. '============================================================================
  274. 'Clears the display of a Color display
  275. '============================================================================
  276. SUB ClearCircle STATIC
  277.     
  278.     STATIC Click!
  279.  
  280. MaxLen = 25   'length of display
  281. Click! = .04
  282. StopNum = MaxLen \ 2 + 1
  283. Characters = 1
  284.  
  285. Attrib = 0
  286. Bottom = MaxLen
  287. Right = 80
  288. Top = 1: Left = 1
  289.  
  290. DO
  291.    
  292.     ROW = Top                 'Clear Across the row
  293.     FOR COL = Left TO Right
  294.         CALL QATTRIB(ROW%, COL%, Characters%, Attrib%)
  295.     NEXT COL
  296.     
  297.     CALL Delayer(